﻿'*******************************************************************
' Program: Data Center Visio Rack Tool
' Author: Albert E Edlund
' Date:
'
' Purpose:
'*******************************************************************

Imports MSEE = Microsoft.Practices.EnterpriseLibrary.ExceptionHandling
Imports Microsoft.Practices.EnterpriseLibrary.Common



Public Class clsMyCollection


#Region "clsItemEdge"

    Public Class clsItemEdge
        '
        ' end points may be either discrete links or
        ' path end points, we'll rely on the instantiation
        ' of the class collection to handle what is placed
        ' into the collection
        '

        '
        ' end points may be either discrete links or
        ' path end points, we'll rely on the instantiation
        ' of the class collection to handle what is placed
        ' into the collection
        ' in the case of paths we will keep a collection of
        ' indices for the links involved in the path
        '


        Public m_pointakey As Int32
        Public m_pointaport As String
        Public m_pointbkey As Int32
        Public m_pointbport As String
        Public m_links As Collection
        Public m_linkct As Integer

        ' used in topology link analysis
        Public m_lnglinkkey As Int32

    End Class
#End Region

#Region "clsColNodes"

    Public Class clsColNodes

        ' used for graph searching
        Public m_nodename As String
        Public m_nodevisited As Boolean

    End Class

#End Region

#Region "clsItemPoint"

    Public Class clsItemPoint

        '
        ' vertex within the network is a component / port tuple
        ' we add the vnettype so that we can make a decision as to
        ' whether we want to stop tracking a path (i.e active parents
        ' can change pathing). We track rackids so that in the event
        ' of a rack drawing we can identify if it leaves a row
        '

        ' the index in the component table
        Public m_nodeindex As Int32
        ' the component name
        Public m_nodename As String
        ' the port name
        Public m_portname As String
        ' this array is the list of links that touch this port
        ' in the database we will save it as a csv string
        Public m_links As Collection
        ' the component type of the parent
        Public m_vnettype As Integer
        ' the rackid associated with this component
        Public m_rackid As String
        Public m_rackkey As Int32


    End Class

#End Region

#Region " Generic collection definitions "

    Public Class clsMyStrings

        '
        ' used to test port and slot names
        '
        Public Function isWellFormedName(ByVal strName As String) As Boolean

            Dim blnReturn As Boolean = False

            Try

                If strName = "" Then GoTo ExitHandler
                Dim strType As String

                Dim intDelCt As Integer
                Dim colString As Collection
                colString = New Collection

                intDelCt = ParseItemsToCollection(strName, colString, "_")

                If intDelCt <> 3 Then GoTo ExitHandler

                strType = LCase(colString.Item(1))
                ' rule 1 has to start with port
                If strType = "port" _
                   Or strType = "slot" Then
                Else
                    GoTo ExitHandler
                End If
                ' the final field must be numeric and greater than zero
                Dim strTemp As String
                strTemp = LCase(colString.Item(3))
                If Not (IsNumeric(strTemp)) Then
                    GoTo ExitHandler
                End If
                If CInt(strTemp) < 1 Then
                    GoTo ExitHandler
                End If

                ' if you made it this far it's ok
                blnReturn = True
ExitHandler:

            Catch ex As Exception
                Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
                If (rethrow) Then
                    ' throw original exception
                    Throw
                End If
            Finally
                isWellFormedName = blnReturn
            End Try

        End Function




        '**************************************************************************
        '
        ' local string handlers
        '
        '**************************************************************************

        '
        '
        '
        Public Function memberOfCollection _
                    (ByVal colObjects As Collection, _
                    ByVal objMember As Object, _
                    Optional ByVal strType As String = "string") _
                    As Boolean

            Dim intX As Integer
            Dim blnReturn As Boolean = False
            Dim blnObject As Boolean = True

            Select Case strType
                Case "string"
                    If Not (TypeOf objMember Is String) Then blnObject = False
                    ' need to be explicit on com+ objects
                Case "int32"
                    If Not (TypeOf objMember Is Int32) Then blnObject = False
                Case "double"
                    If Not (TypeOf objMember Is Double) Then blnObject = False
                Case "integer"
                    If Not (TypeOf objMember Is Integer) Then blnObject = False
                    ' where long is 32bit on 32bit machine it becomes 64bit on upscale
                Case "long"
                    If Not (TypeOf objMember Is Long) Then blnObject = False
                Case Else
                    blnObject = False
            End Select

            Try
                ' we passed the objecttype test
                If blnObject = True Then
                    For intX = 1 To colObjects.Count
                        Select Case strType
                            Case "string"
                                If LCase(objMember) = LCase(colObjects.Item(intX)) Then
                                    blnReturn = True
                                    Exit For
                                End If
                            Case "long", "double", "integer", "int32"
                                If objMember = colObjects.Item(intX) Then
                                    blnReturn = True
                                    Exit For
                                End If
                        End Select
                    Next intX
                End If

            Catch ex As Exception
                Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
                If (rethrow) Then
                    ' throw original exception
                    Throw
                End If

            Finally

                memberOfCollection = blnReturn

            End Try




        End Function

        '
        '
        '
        Public Sub removeStringFromCollection _
                (ByRef colStrings As Collection, _
                ByVal strRemove As String)

            Try

                Dim intX As Integer
                For intX = colStrings.Count To 1 Step -1
                    If LCase(colStrings.Item(intX)) = LCase(strRemove) Then
                        colStrings.Remove(intX)
                    End If
                Next intX
                Exit Sub
            Catch my_exception As Exception
                Debug.Print("removestringfromcollection " & my_exception.Message)
            End Try
        End Sub


        '
        '
        '
        Public Sub addStringToCollection _
                (ByRef colStrings As Collection, _
                ByVal strNew As String, _
                Optional ByVal blnUnique As Boolean = True)

            Dim intX As Integer
            Dim blnFound As Boolean
            blnFound = False

            '
            ' blnUnique ensures that the result is a list of unique names
            '
            If blnUnique = True Then
                For intX = 1 To colStrings.Count
                    If colStrings.Item(intX) = strNew Then
                        blnFound = True
                        GoTo Found
                    End If
                Next intX
            End If

Found:
            If blnFound = False Then
                colStrings.Add(strNew)
            End If

        End Sub

        '
        ' pass in a string, collection, and delimiter - update the collection and return count
        '
        Public Function ParseItemsToCollection _
            (ByVal s As String, _
            ByRef colA As Collection, _
            ByVal Delim As String, _
            Optional ByVal strType As String = "string") _
            As Integer

            Try

                '
                Dim p As Int32
                '
                ' Check for valid delimiter
                '
                If Delim = "" Then
                    ParseItemsToCollection = -1
                    Exit Function
                End If
                Dim intT32 As Int32

                '
                ' Copy Items
                '
                p = InStr(1, s, Delim, vbTextCompare)
                Do While p > 0

                    Select Case strType
                        Case "string"
                            colA.Add(Left$(s, p - 1))
                        Case "integer"
                            colA.Add(CInt(Left$(s, p - 1)))
                        Case "double"
                            colA.Add(CDbl(Left$(s, p - 1)))
                        Case "int32"
                            intT32 = CInt(Left$(s, p - 1))
                            colA.Add(intT32)
                        Case "long"
                            colA.Add(CLng(Left$(s, p - 1)))
                    End Select
                    s = Mid$(s, p + 1)
                    p = InStr(1, s, Delim, vbTextCompare)
                Loop
                '
                ' Copy Last Item
                '
                Select Case strType
                    Case "string"
                        colA.Add(s)
                    Case "integer"
                        colA.Add(CInt(s))
                    Case "double"
                        colA.Add(CDbl(s))
                    Case "int32"
                        intT32 = CInt(s)
                        colA.Add(intT32)
                    Case "long"
                        colA.Add(CLng(s))
                End Select


            Catch ex As Exception
                Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
                If (rethrow) Then
                    ' throw original exception
                    Throw
                End If
            Finally

                ParseItemsToCollection = colA.Count
            End Try

        End Function

        '
        ' create a csv string with end brackets from a collection
        '
        Public Function BuildCsvString _
            (ByVal colA As Collection) _
            As String

            Dim intY As Integer
            Dim strCsv As String = "[]"
            Try

                If (colA Is Nothing) _
                    Or (colA.Count = 0) Then
                    Exit Try
                Else
                    With colA
                        ' start bracket
                        strCsv = "["
                        For intY = 1 To colA.Count
                            strCsv = strCsv & CStr(colA.Item(intY))
                            If intY <> colA.Count Then
                                strCsv = strCsv & ","
                            End If ' test for last position
                        Next intY
                        ' end bracket
                        strCsv = strCsv & "]"
                    End With
                End If

            Catch ex As Exception
                Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
                If (rethrow) Then
                    ' throw original exception
                    Throw
                End If
                strCsv = "[]"
            End Try

            BuildCsvString = strCsv

        End Function


        '
        ' pass in a bracketed string of csv separated items and pass back a collection
        ' strType allows the user to define what the collection is composed of
        '
        Public Function BuildCsvCollection _
                (ByVal strCsv As String, _
                Optional ByVal strType As String = "string", _
                Optional ByVal strDel As String = ",") _
                As Collection

            Dim colReturn As Collection
            colReturn = New Collection
            Try
                Dim intX As Integer

                ' get rid of first bracket
                If InStr(1, strCsv, "[") Then
                    strCsv = Microsoft.VisualBasic.Replace(strCsv, "[", "")
                Else
                    GoTo ExitHandler
                End If
                ' get rid of second bracket
                If InStr(1, strCsv, "]") Then
                    strCsv = Microsoft.VisualBasic.Replace(strCsv, "]", "")
                Else
                    GoTo ExitHandler
                End If

                intX = ParseItemsToCollection(strCsv, colReturn, strDel, strType)

ExitHandler:
                BuildCsvCollection = colReturn
                Exit Function

            Catch ex As Exception
                Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
                If (rethrow) Then
                    ' throw original exception
                    Throw
                End If
                BuildCsvCollection = colReturn
            End Try

        End Function


        Function GetToken _
                (ByVal strS As String, _
                ByVal strD As String, _
                ByVal Indx As Integer) _
                As String

            Dim WC As Integer
            Dim Count As Integer
            Dim SPos As Integer
            Dim EPos As Integer
            Dim strReturn As String
            strReturn = ""

            On Error GoTo ErrHandler

            strS = LTrim(RTrim(strS))

            WC = CountTokens(strS, strD)

            If Indx < 1 Or WC < Indx Then
                GoTo ExitHandler
            End If

            Count = 1
            SPos = 1
            For Count = 2 To Indx
                SPos = InStr(SPos, strS, strD) + 1
            Next Count
            EPos = InStr(SPos, strS, strD) - 1
            If EPos <= 0 Then EPos = Len(strS)
            strReturn = Mid(strS, SPos, EPos - SPos + 1)

ExitHandler:

            GetToken = strReturn
            Exit Function

ErrHandler:

            GetToken = strReturn
            Debug.Print("GetToken Err " & Err.Description)

        End Function

        '
        '
        '
        Function CountTokens _
                (ByVal s As String, _
                ByVal D As String) _
                As Integer
            '
            ' Counts delimters in a string separated by input string D
            '
            Dim WC As Integer
            Dim Pos As Integer

            ' has to be a string, has to have a length
            If VarType(s) <> 8 _
                  Or Len(s) < 1 _
                  Or InStr(s, D) < 1 Then
                CountTokens = 0
                Exit Function
            End If

            WC = 0
            Pos = InStr(s, D)
            Do While Pos > 0
                WC = WC + 1
                Pos = InStr(Pos + 1, s, D)
            Loop

            ' tokens is equal to delimiters + 1
            CountTokens = WC + 1

        End Function




    End Class

#End Region

#Region " myCollection definitions "



    '
    ' a topology is a collection of paths and the nodes touched
    ' a path is a collection of links and is defined by with two end-points (ports)
    ' (this allows us to use the same collection logic for links and paths)
    ' a links is an edge edge with two end-points (ports)
    ' a port is defined as a node and a connection point on the node
    '


    Private _pName As String
    Private _pType As String

    '
    ' types are standard, stack, lifo, fifo, priority
    '

    Private _pCapacity As Integer
    Private _pArray() As Object
    Private _pIndex As Integer
    Private _pCount As Integer
    Const _intIncrement As Integer = 16



    '*********************************************************************
    ' collection path/links end-points
    '*********************************************************************

#Region " path/links "


    Public Function ExistsLink _
            (ByVal objItem As clsItemEdge) _
            As Boolean


        Dim intX As Integer
        Dim blnFlag As Boolean = False
        Try

            Dim objTest As clsItemEdge

            For intX = 0 To _pCount - 1
                If Not (_pArray(intX) Is Nothing) Then
                    objTest = Nothing
                    objTest = New clsItemEdge
                    objTest = _pArray(intX)
                    If (((objTest.m_pointakey) = (objItem.m_pointakey)) _
                        And ((LCase(objTest.m_pointaport)) = (LCase(objItem.m_pointaport))) _
                        And ((objTest.m_pointbkey) = (objItem.m_pointbkey)) _
                        And ((LCase(objTest.m_pointbport)) = (LCase(objItem.m_pointbport))) _
                        Or ((objTest.m_pointakey = (objItem.m_pointbkey)) _
                        And ((LCase(objTest.m_pointaport)) = (LCase(objItem.m_pointbport))) _
                        And ((objTest.m_pointbkey) = (objItem.m_pointakey)) _
                        And ((LCase(objTest.m_pointbport)) = (LCase(objItem.m_pointaport))))) Then
                        blnFlag = True
                        Exit For
                    End If
                End If
            Next intX

            ExistsLink = blnFlag
            Exit Function

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try


    End Function


    Public Function IndexOfLink _
            (ByVal objItem As clsItemEdge) _
            As Integer

        Dim intX As Integer
        Dim intPos As Integer = -1
        Try
            Dim objTest As clsItemEdge

            For intX = 0 To _pCount - 1
                If Not (_pArray(intX) Is Nothing) Then
                    objTest = Nothing
                    objTest = New clsItemEdge
                    objTest = _pArray(intX)

                    If (((objTest.m_pointakey) = (objItem.m_pointakey)) _
                        And ((LCase(objTest.m_pointaport)) = (LCase(objItem.m_pointaport))) _
                        And ((objTest.m_pointbkey) = (objItem.m_pointbkey)) _
                        And ((LCase(objTest.m_pointbport)) = (LCase(objItem.m_pointbport))) _
                        Or ((objTest.m_pointakey = (objItem.m_pointbkey)) _
                        And ((LCase(objTest.m_pointaport)) = (LCase(objItem.m_pointbport))) _
                        And ((objTest.m_pointbkey) = (objItem.m_pointakey)) _
                        And ((LCase(objTest.m_pointbport)) = (LCase(objItem.m_pointaport))))) Then
                        intPos = intX
                        Exit For
                    End If

                End If
            Next intX

            IndexOfLink = intPos
            Exit Function
        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            IndexOfLink = -1
        End Try
    End Function

    Public Function IndexOfLinkKey _
            (ByVal lngLinkKey As Int32) _
            As Integer

        Dim intX As Integer
        Dim intPos As Integer = -1
        Dim objTest As clsItemEdge
        Try

            For intX = 0 To _pCount - 1
                If Not (_pArray(intX) Is Nothing) Then
                    objTest = Nothing
                    objTest = New clsItemEdge
                    objTest = _pArray(intX)
                    If objTest.m_lnglinkkey = lngLinkKey Then
                        intPos = intX
                        Exit For
                    End If
                End If
            Next intX

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        Finally
            IndexOfLinkKey = intPos
        End Try

    End Function


    Public Sub RemoveLink _
            (ByVal objItem As clsItemEdge)

        Dim intPos As Integer
        Dim blnObjFound As Boolean
        blnObjFound = False
        Try

            ' check to see if it is there first
            blnObjFound = Me.ExistsLink(objItem)

            If blnObjFound = True Then
                intPos = Me.IndexOfLink(objItem)
                _pArray(intPos) = Nothing
                ShiftUp(intPos)
                _pCount = _pCount - 1
            Else
                Debug.Print("Remove Link NotFound")
            End If
            Exit Sub

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try

    End Sub

#End Region

    '*********************************************************************
    ' collection end-points (ports from drawing)
    '*********************************************************************

#Region " ports "

    Public Function ExistsPort _
            (ByVal objItem As clsItemPoint) _
            As Boolean


        Dim intX As Integer
        Dim blnFlag As Boolean = False

        Try
            Dim objTest As clsItemPoint = New clsItemPoint

            For intX = 0 To _pCount - 1
                If Not (_pArray(intX) Is Nothing) Then
                    objTest = Nothing
                    objTest = New clsItemPoint
                    objTest = _pArray(intX)
                    If ((objTest.m_nodeindex = objItem.m_nodeindex) _
                        And (LCase(objTest.m_portname) = LCase(objItem.m_portname))) Then
                        blnFlag = True
                        Exit For
                    End If
                End If
            Next intX


        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If

        Finally
            ExistsPort = blnFlag
        End Try

    End Function

    '
    ' use this as an alternative to node item searches
    ' to cut down on time, search active points only when
    ' implementing
    '
    Public Function ExistsPortNodeName _
            (ByVal objItem As clsItemPoint) _
            As Boolean


        Dim intX As Integer
        Dim blnFlag As Boolean = False
        Try
            Dim objTest As clsItemPoint

            For intX = 0 To _pCount - 1
                If Not (_pArray(intX) Is Nothing) Then
                    objTest = Nothing
                    objTest = New clsItemPoint
                    objTest = _pArray(intX)
                    If (LCase(objTest.m_nodename) = LCase(objItem.m_nodename)) Then
                        blnFlag = True
                        Exit For
                    End If
                End If

            Next intX



        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        Finally
            ExistsPortNodeName = False

        End Try
    End Function

    '
    ' this searchs by node name and port name
    '
    Public Function IndexOfPortName _
            (ByVal objItem As clsItemPoint) _
            As Integer

        Dim intX As Integer
        Dim intPos As Integer = -1
        Try
            Dim objTest As clsItemPoint
            objTest = New clsItemPoint

            If objItem Is Nothing Then
                Return intPos
            End If

            For intX = 0 To UBound(_pArray)
                If Not (_pArray(intX) Is Nothing) Then
                    objTest = Nothing
                    objTest = New clsItemPoint
                    objTest = _pArray(intX)
                    If ((LCase(objTest.m_nodename) = LCase(objItem.m_nodename)) _
                        And (LCase(objTest.m_portname) = LCase(objItem.m_portname))) Then
                        intPos = intX
                        Exit For
                    End If
                End If
            Next intX


        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        Finally
            IndexOfPortName = intPos
        End Try
    End Function

    '
    ' this identifies by index and port name
    '
    Public Function IndexOfPort _
            (ByVal objItem As clsItemPoint) _
            As Integer


        Dim intX As Integer
        Dim intPos As Integer = -1
        Try
            Dim objTest As clsItemPoint
            objTest = New clsItemPoint


            If objItem Is Nothing Then
                Return intPos
            End If

            For intX = 0 To UBound(_pArray)
                If Not (_pArray(intX) Is Nothing) Then
                    objTest = Nothing
                    objTest = New clsItemPoint
                    objTest = _pArray(intX)
                    If ((objTest.m_nodeindex = objItem.m_nodeindex) _
                        And (LCase(objTest.m_portname) = LCase(objItem.m_portname))) Then
                        intPos = intX
                        Exit For
                    End If
                End If
            Next intX

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        Finally
            IndexOfPort = intPos
        End Try

    End Function

    Public Sub RemovePort _
            (ByVal objItem As clsItemPoint)

        Dim intPos As Integer
        Dim blnObjFound As Boolean
        blnObjFound = False

        Try

            ' check to see if it is there first
            blnObjFound = Me.ExistsPort(objItem)

            If blnObjFound = True Then
                intPos = Me.IndexOfPort(objItem)
                _pArray(intPos) = Nothing
                ShiftUp(intPos)
                _pCount = _pCount - 1
            Else
                Debug.Print("Remove Port Not Found ")
            End If

            Exit Sub

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try

    End Sub


#End Region




    '*********************************************************************
    '
    ' methods that pretend to be queue
    '
    '*********************************************************************

    Public Sub EnQueue(ByVal objValue As Object, _
                Optional ByVal strCaller As String = "")

        Try

            If objValue Is Nothing Then
                Debug.Print("Enqueue is Nothing")
                If strCaller <> "" Then
                    Debug.Print("Caller: " & strCaller)
                End If
                Exit Sub
            End If

            Add(objValue)
            Exit Sub

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try

    End Sub


    Public Function DeQueue() As Object

        Dim objReturn As Object

        Try
            Select Case _pType
                Case "LIFO"
                    objReturn = DequeueLIFO()

                Case "FIFO"
                    objReturn = DequeueFIFO()

                Case Else

                    objReturn = Nothing

            End Select




        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            objReturn = Nothing
        End Try

        DeQueue = objReturn

    End Function

    '
    ' last in first out
    '
    Private Function DequeueLIFO() As Object


        Dim retObj As Object = Nothing

        Try
            ' count is one based, array is zero
            ' point at top
            retObj = GetItem(_pCount - 1)
            _pArray(_pCount - 1) = Nothing
            ' reduce the count
            _pCount = _pCount - 1
            ' point at next slot
            _pIndex = _pCount


        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            retObj = Nothing
        End Try

        DequeueLIFO = retObj

    End Function


    Private Function DequeueFIFO() As Object


        Dim retObj As Object = Nothing

        Try
            ' count is one based, array is zero
            ' point at top
            retObj = GetItem(0)
            RemoveAt(0)
            ' point at next slot
            _pIndex = _pCount



        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            retObj = Nothing
        End Try

        DequeueFIFO = retObj

    End Function


    '*********************************************************************
    '
    ' methods that pretend to be stack
    '
    '*********************************************************************



    Public Sub Push(ByVal objValue As Object)

        Add(objValue)

    End Sub


    '
    ' last in first out
    '
    Public Function Pop() As Object


        Dim retObj As Object
        Try
            ' count is one based, array is zero
            ' point at top
            retObj = GetItem(_pCount - 1)
            ' reduce the count
            _pCount = _pCount - 1
            ' point at next slot
            _pIndex = _pCount
            Pop = retObj
            Exit Function

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            Pop = Nothing
        End Try
    End Function

    Public Function Peek() As Object


        Dim retObj As Object
        Try
            ' get the top
            retObj = GetItem(_pCount - 1)
            Peek = retObj
            Exit Function

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            Peek = Nothing
        End Try
    End Function




    '*********************************************************************
    '
    ' methods that don't care about content
    '
    '*********************************************************************


    Public Property count() As Integer
        Get
            count = _pCount
        End Get
        Set(ByVal value As Integer)
            _pCount = value
        End Set
    End Property


    Public Sub initClass(ByVal strName As String, _
                Optional ByVal strType As String = "standard")
        _pIndex = 0
        _pCount = 0
        _pCapacity = _intIncrement
        ReDim _pArray(_pCapacity - 1)
        _pName = strName
        _pType = strType
    End Sub


    '
    ' add object to collection
    '
    Public Sub Add(ByVal objItem As Object)

        Try

            If objItem Is Nothing Then
                Debug.Print("AddToColl is Nothing")
                Exit Sub
            End If

            Dim strName As String
            strName = _pName

            If IsFull() = True Then
                _pCapacity = _pCapacity + _intIncrement
                ReDim Preserve _pArray(_pCapacity - 1)
            End If

            Dim myObj As Object
            myObj = objItem

            _pArray(_pIndex) = myObj
            _pIndex = _pIndex + 1
            _pCount = _pCount + 1
            Exit Sub

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try
    End Sub

    Private Function IsFull() _
        As Boolean

        Try

            Dim strName As String
            strName = _pName

            If Not (_pArray(_pCapacity - 1) Is Nothing) Then
                IsFull = True
            Else
                IsFull = False
            End If
            Exit Function

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            IsFull = True
        End Try
    End Function

    Public Sub Clear()

        _pCapacity = _intIncrement
        ReDim _pArray(_intIncrement - 1)
        _pCount = 0
        _pIndex = 0

    End Sub


    Public Sub CopyTo(ByRef objCollection As Collection)

        Dim intX As Integer
        ReDim Preserve _pArray(_pCount - 1)

        For intX = 0 To _pCount - 1
            objCollection.Add(_pArray(intX))
        Next intX


    End Sub

    Private Sub ShiftUp(ByVal intP As Integer)

        Try

            Dim intX As Integer

            For intX = intP To UBound(_pArray) - 1
                _pArray(intX) = _pArray(intX + 1)
            Next intX

            _pIndex = SetIndex()

            Exit Sub

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try
    End Sub


    Public Sub Display()

        Dim intX As Integer
        For intX = 0 To _pCount - 1
            Debug.Print(_pArray(intX))
        Next intX

    End Sub


    Private Function SetIndex() As Integer



        Dim intReturn As Integer = -1
        Try
            Dim intX As Integer

            For intX = 0 To UBound(_pArray)
                If _pArray(intX) Is Nothing Then
                    intReturn = intX
                    Exit For
                End If
            Next intX

            SetIndex = intReturn
            Exit Function

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            SetIndex = intReturn
        End Try
    End Function


    Private Sub RangeShiftUp(ByVal intPos As Integer, ByVal intN As Integer)

        Dim intY As Integer
        Dim objToMove As Object

        intY = intPos + intN
        objToMove = _pArray(intY)

        While (Not (objToMove Is Nothing) And (intY < _pCount))
            _pArray(intPos) = objToMove
            _pArray(intY) = Nothing
            intPos = intPos + 1
            intY = intY + 1
            objToMove = _pArray(intY)
        End While

        _pIndex = SetIndex()

        For intY = _pIndex To _pCapacity
            _pArray(intY) = Nothing
        Next

    End Sub

    Public Sub RemoveAt(ByVal intP As Integer)

        Try

            _pArray(intP) = Nothing
            _pCount = _pCount - 1
            ShiftUp(intP)
            Exit Sub

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try
    End Sub


    Private Sub ShiftDown(ByVal intN As Integer)

        Try

            Dim intX As Integer
            If IsFull() Then
                _pCapacity = _pCapacity + _intIncrement
                ReDim Preserve _pArray(_pCapacity)
            End If

            For intX = _pIndex - 1 To intN Step -1
                _pArray(intX + 1) = _pArray(intX)
            Next intX

            _pArray(intN) = Nothing
            _pIndex = _pIndex + 1
            _pCount = _pCount + 1
            Exit Sub

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try
    End Sub

    Public Sub Insert(ByVal objItem As Object, ByVal intPos As Integer)

        Try

            ShiftDown(intPos)
            _pArray(intPos) = objItem
            Exit Sub

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try
    End Sub

    Public Function GetItem(ByVal intItem As Integer) As Object

        Dim objReturn As Object = Nothing

        If Not (_pArray(intItem) Is Nothing) Then
            objReturn = _pArray(intItem)
        End If

        GetItem = objReturn

    End Function

    Public Sub Remove(ByVal objItem As Object)

        Dim intPos As Integer
        Dim blnObjFound As Boolean
        blnObjFound = False

        Try

            ' check to see if it is there first
            blnObjFound = Me.Exists(objItem)

            If blnObjFound = True Then
                intPos = Me.IndexOf(objItem)
                _pArray(intPos) = Nothing
                ShiftUp(intPos)
                _pCount = _pCount - 1
            End If

            Exit Sub

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
        End Try
    End Sub


    Public Function Exists(ByVal objItem As Object) _
        As Boolean


        Dim intX As Integer
        Dim blnFlag As Boolean = False
        Try
            Dim objTest As Object

            For intX = 0 To _pCount - 1
                If Not (_pArray(intX) Is Nothing) Then
                    objTest = _pArray(intX)
                    If objTest Is objItem Then
                        blnFlag = True
                        Exit For
                    End If
                End If
            Next intX

            Exists = blnFlag
            Exit Function

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            Exists = blnFlag
        End Try
    End Function


    Public Function IndexOf(ByVal objItem As Object) _
        As Integer

        Dim intX As Integer
        Dim intPos As Integer
        Dim objTest As Object
        intPos = -1

        For intX = 0 To UBound(_pArray)
            If Not (_pArray(intX) Is Nothing) Then
                objTest = _pArray(intX)
                If objTest Is objItem Then
                    intPos = intX
                    Exit For
                End If
            End If
        Next intX

        IndexOf = intPos

    End Function


    Public Function Replace(ByVal intIndex As Integer, ByVal objItem As Object) _
        As Boolean



        Dim blnReturn As Boolean = False
        Try
            Dim strCollection As String
            strCollection = _pName

            _pArray(intIndex) = objItem

            Replace = True
            Exit Function

        Catch ex As Exception
            Dim rethrow As Boolean = MSEE.ExceptionPolicy.HandleException(ex, "Global Policy")
            If (rethrow) Then
                ' throw original exception
                Throw
            End If
            Replace = blnReturn
        End Try
    End Function


#End Region


    ' 
    ' use this to initialize the collections stuff
    '
    Public Sub New(ByVal strName As String, _
        Optional ByVal strType As String = "standard")
        _pIndex = 0
        _pCount = 0
        _pCapacity = _intIncrement
        ReDim _pArray(_pCapacity - 1)
        _pName = strName
        _pType = strType
    End Sub


End Class



